home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1991: Code Warrior / bincue / Code Warrior.bin / Tools & Apps (Moof!) / Graphics & Imaging / PICT / DumpScreen / ScreenSpool.p < prev    next >
Encoding:
Text File  |  1990-09-14  |  2.8 KB  |  114 lines  |  [TEXT/MPS ]
  1. { Sample program to show how to spool out a PICT file containg the
  2.   image of the Macintosh II main screen
  3. }
  4.  
  5. { By Guillermo Ortiz
  6.   Macintosh Developer Technical Support
  7. }
  8.  
  9. { This code is provided only as a sample. 
  10.   No claims are made regarding its fitness for any particular purpose
  11. }
  12.  
  13. { See IM V for comments and details }
  14.  
  15. Program ScreenSpool;
  16.  
  17. USES Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf;
  18.  
  19. TYPE BitMapPtr = ^BitMap;
  20.  
  21. VAR     pHand2: PicHandle;
  22.           globalRef: INTEGER;
  23.         
  24. Procedure PutPICTData(dataPtr: Ptr; byteCount: Integer);
  25.  
  26. VAR longCount:LONGINT;
  27.  
  28. BEGIN
  29.     longCount:= byteCount;
  30.     IF FSWrite( globalRef, longCount, dataPtr) <> noErr THEN Debugger;
  31.     IF pHand2 <> NIL THEN
  32.       pHand2^^.picSize:=pHand2^^.picSize + longCount;
  33. END;
  34.  
  35. PROCEDURE SpitItOut;
  36. VAR
  37.   err: OSErr;
  38.   i, vrefnum: INTEGER;
  39.   longCount,
  40.   longZero: LONGINT;
  41.   reply: SFReply;            { reply record }
  42.   myProcs: CQDProcs;
  43.   volName: Str255;
  44.   currGDHand: GDHandle;
  45.   where: Point;
  46.   oldPort: GrafPtr;
  47.   myPort:CGrafPort;
  48.   myPortPtr: CGrafPtr;
  49.   myDev: GDHandle;
  50.    
  51. BEGIN
  52.          GetPort(oldPort);
  53.          myPortPtr:= @myPort;     { initialize }
  54.          OpenCPort(myPortPtr);    { set my port }
  55.          
  56.          where.h:= 20;
  57.          where.v:=20;
  58.          SFPutFile(where,'Save picture as: ','untitled',NIL,reply);IF NOT(reply.good) THEN Debugger;
  59.          Err:= GetVol(@volName,reply.vrefnum);IF err<>0 THEN Debugger;
  60.          err:= Create(reply.fName,reply.vrefnum,'.GAO','PICT');IF err<>0 THEN Debugger;
  61.          err := FSOpen(reply.fName,reply.vrefnum, globalRef); IF err<>0 THEN Debugger;
  62.  
  63.          pHand2 := NIL; { The bottle neck proc checks this to see if it needs to save size }
  64.         
  65.          SetPort(GrafPtr(myPortPtr));
  66.          
  67.          SetStdCProcs(myProcs);
  68.          GrafPtr(myPortPtr)^.grafProcs:=@myProcs;
  69.          myProcs.putPicProc:=@PutPictData;
  70.          
  71.          
  72.          myDev:= GetMainDevice;
  73.          
  74.          longZero := 0;
  75.          longCount := 4;
  76.          FOR i := 1 TO (512 + SizeOf(Picture)) DIV 4 DO
  77.            err := FSWrite (globalRef, longCount, @longZero);
  78.  
  79.             ClipRect(myDev^^.gdPMap^^.bounds); {Comment this out and nothing will save to disk! }
  80.  
  81.          pHand2 := OpenPicture (myDev^^.gdPMap^^.bounds);
  82.          
  83. { This copybits call saves the contents of the whole screen into the PICT }
  84.          CopyBits(BitMapPtr(myDev^^.gdPMap^)^, 
  85.                   BitMapPtr(myDev^^.gdPMap^)^,
  86.                   myDev^^.gdPMap^^.bounds,
  87.                     myDev^^.gdPMap^^.bounds,
  88.                   0, NIL);
  89.          ClosePicture;
  90.        
  91.          IF SetFPos (globalRef, fsFromStart, 512) <> noErr THEN Debugger;
  92.          longCount := SizeOf(Picture); {GetHandleSize(Handle(pHand2));}
  93.          IF FSWrite (globalRef,longCount , Ptr(pHand2^)) <> noErr THEN Debugger;
  94.  
  95.          IF FSClose (globalRef) <> noErr THEN Debugger;
  96.  
  97.           GrafPtr(myPortPtr)^.grafProcs:=NIL;
  98.          
  99.          KillPicture (pHand2);
  100.          SetPort(oldPort);
  101. END; {SpitItOut}
  102.  
  103. BEGIN
  104.         InitGraf(@thePort);
  105.         InitFonts;
  106.         FlushEvents(everyEvent, 0);
  107.         InitWindows;
  108.         InitMenus;
  109.         TEInit;
  110.         InitDialogs(NIL);
  111.         InitCursor;
  112.         
  113.         SpitItOut;
  114. END.